Games of Daze/Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso/x2ftp/msdos/net/netware/nwacct.pas

Pascal/Delphi Source File | 1995-03-20 | 18.1 KB | 509 lines

{$X+,V-,B-}
Unit nwAcct;

INTERFACE

Uses nwMisc,nwBindry,nwConn;

{ Primary functions:                  Interrupt: Comments:

* GetAccountStatus                    (F217/96)  (1)
* SubmitAccountCharge                 (F217/97)  (2)(3)
* SubmitAccountHold                   (F217/98)  (2)
* SubmitAccountNote                   (F217/99)  (2)

  Secondary functions:

* AccountingInstalled    (4)
* SetAccountStatus       (5)
* AddAccountingServer    (5)
* DeleteAccountingServer (5)
* DeleteAccountHolds     (2)

  Notes: (1) To be called by:
             -accounting servers;
             -supervisor equivalent users;
             -objects querying their own account status.
         (2) To be called by accounting servers only.
         (3) Can be imitated by supervisor-equivalent users by
             calling GetAccountStatus and SetAccountStatus. Atomicity
             of such a bindery transaction can not be guaranteed.
         (4) Can be called by all logged on users.
         (5) Supervisor equivalent users only.

}

Var result:word;


{F217/96 [2.15c+]}
Function GetAccountStatus(objName:string; objType:word;
                          Var balance,limit,holds:LongInt):boolean;
{ equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
  of the object. The properties may not exist. }
{ !! will only work when the caller is an accounting server !! }

{F217/97 [2.15c+]}
Function SubmitAccountCharge(objName:string; objType:word;
                             charge,cancelHoldAmount:Longint;
                             serviceType, commentType:word; comment:string):boolean;
{ -The cancelHold amount should be exactly the same as the amount that
   was put on huld with the SubmitAccountHold call. If no
   SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
  -'negative charges' are allowed. They will increase the balance of
   the object objName of objType.
  -Use the objectType of caller for the serviceType parameter.
   (audit log purposes)
  -Set commentType to 0 and comment to '' if you aren't interested in the
   audit log. }

{F217/98 [2.15c+]}
Function SubmitAccountHold(objName:string; objType:word;
                           reserveAmount:Longint         ):boolean;

{F217/99 [2.15c+]}
Function SubmitAccountNote(objName:string; objType:word;
                           serviceType,commentType:word; comment:string):boolean;

{--------Secondary Functions-----------------------------------------------}

Function AccountingInstalled:boolean;
Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
{ need to be supervisor equivalent to use this call }
Function AddAccountingServer(objName:string;objType:word):boolean;
{ need to be supervisor equivalent to use this call }
Function DeleteAccountingServer(objName:string;objType:word):boolean;
{ need to be supervisor equivalent to use this call }
Function DeleteAccountHolds(objName:string; objType:word):boolean;
{ delete all holds the caller (an accounting server) has on the
  object with name objName of type objType. }

Type Tcharge=record
             DaysOfCharge:Byte; { bit 0=sunday,.. bit 6=saturday }
             TimeOfCharge:Byte; { 0:00=0 ..23:30 =47, half-hour
                                  during which the specified 'new' rate takes effect. }
             ChargeRateMultiplier,
             ChargeRateDivisor:Word;
             end;
     TchargeRec=record
                NextChargeTime:Longint; { minutes since 1-1-1985 }
                charges:array[1..20] of Tcharge;
                end;


Type TchargeTableEntry=array[0..47] of Real;
Var ChargeTable:Array [0..6] of TchargeTableEntry;

IMPLEMENTATION {===========================================================}

USES Dos;

Var UnitReqBuffer:array[1..576] of byte;
    UnitReplyBuffer:array[1..576] of byte;
    UnitRegs:registers;

Procedure F2SystemCall(subf:byte;req_size,rep_size:word);
begin
With UnitRegs
 do begin
    DS := Seg(UnitReqBuffer);  SI := Ofs(UnitReqBuffer);   CX := Req_size;
    ES := Seg(UnitReplyBuffer);DI := Ofs(UnitReplyBuffer); DX := rep_size;
    AH := $F2; AL := subf;
    MSDOS(UnitRegs);
    Result:=al;
    end;
end;

Procedure GetBindryAccountStatus(objName:string; objType:word;
                                Var balance,limit,holds:LongInt);
{ called by GetAccountStatus when the calling object isn't an
  accounting server. The F217/96 fails, but a bindery read will
  work for supervisor-equivalent users. }
Var accPropVal:propertyType;
    accVal: record
            _balance:LongInt; {hi-lo}
            _limit:LongInt;   {hi-lo}
            _Reserved:array[1..120] of byte; { NW internal info }
            end ABSOLUTE accPropVal;
    holdPropVal:propertyType;
    holdVal: array[1..16]
              of record
                 AccountServerID:Longint; {hi-lo}
                 HoldAmount     :LongInt; {hi-lo}
                 end ABSOLUTE holdPropVal;
    moreSegments:boolean;
    t,propFlags:byte;
begin
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
                    accPropVal,moreSegments,propFlags)
  then begin
       balance:=Lswap(accVal._balance);
       limit:=Lswap(accVal._limit);
       IF ReadPropertyValue(objName,objType,'ACCOUNT_HOLDS',1,
                            holdPropVal,moreSegments,propFlags)
        then begin { holds exist. }
             holds:=0;
             for t:=1 to 16
              do if holdVal[t].AccountServerID<>0
                 then holds:=holds+Lswap(holdVal[t].HoldAmount);
             end;
       if nwBindry.result=$FB
         then begin
              result:=0;
              holds:=0;
              end
         else result:=nwBindry.result;
       end
  else if nwBindry.result=$FB { no such property }
        then result:=$C1
        else if nwBindry.result=$F1 { invalid bindery security }
             then result:=$C0
             else result:=nwBindry.result;
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
  96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
  FF Bindery Failure}
end;


{F217/96 [2.15c+]}
Function GetAccountStatus(objName:string; objType:word;
                          Var balance,limit,holds:LongInt):boolean;
{ equivalent to reading the ACCOUNT_BALANCE and ACCOUNT_HOLDS properties
  of the object. The properties may not exist. }
{ This function will be successfull if:
     a) the caller is an accounting server on the current fileserver
  OR b) the caller is supervisor-equivalent
  OR c) the caller is querying his own account status }
var req:record
        len:word;
        subF:byte;
        _objType:word; {hi-lo}
        _objName:string[48];
        end                   ABSOLUTE UnitReqBuffer;
    reply:record
          _balance: LongInt; {hi-lo}
          _limit  : Longint; {hi-lo}
          reserved: array [1..120] of byte;
          _holds  : array [1..16]
                     of record
                        serverObjId:LongInt; {hi-lo}
                        HoldAmount :LongInt  {hi-lo}
                        end;
          end                 ABSOLUTE UnitReplyBuffer;
    t:byte;
begin
With req
 do begin
    len:=sizeOf(req)-2;
    subf:=$96;
    _objType:=swap(objType); { force hi-lo}
    PstrCopy(_objName,objName,48); UpString(_objName);
    end;
F2SystemCall($17,sizeOf(req),sizeOf(reply));
With reply
 do begin
    balance:=Lswap(_balance); { force lo-hi again }
    limit:=Lswap(_limit); { force lo-hi again }
    holds:=0;
    for t:=1 to 16
     do if _holds[t].serverObjId<>0
      then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
    end;
IF result=$C0 { no account privileges }
 then GetBindryAccountStatus(objName,objType,balance,limit,holds);
      { try to read status not as an accounting server, but as a supervisor }
GetAccountStatus:=(result=0);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
end;


{F217/97 [2.15c+]}
Function SubmitAccountCharge(objName:string; objType:word;
                             charge,cancelHoldAmount:Longint;
                             serviceType, commentType:word; comment:string):boolean;
{ -The cancelHold amount should be exactly the same as the amount that
   was put on huld with the SubmitAccountHold call. If no
   SubmitAccountHold call was made, the cancelHoldAmount should be set to zero.
  -'negative charges' are allowed. They will increase the balance of
   the object objName of objType.
  -Use the objectType of caller for the serviceType parameter.
   (audit log purposes)
  -Set commentType to 0 and comment to '' if you aren't interested in the
   audit log.
  -To be called by accounting servers only.
  -Can be imitated by supervisor-equivalent users by
   calling GetAccountStatus and SetAccountStatus. Atomicity
   of such a bindery transcation can not be guaranteed.

   }
Var req:record
        len :word;
        subf:byte;
        _serviceType:word;    {hi-lo}
        _charge     :Longint; {hi-lo}
        _cancelHold :Longint; {hi-lo}
        _objType    :word;    {hi-lo}
        _commentType:word;    {hi-lo}
        _objNameAndComment:Array[1..305] of char;
        end                ABSOLUTE UnitReqBuffer;
    p:byte;
begin
With req
do begin
   subf:=$97;
   _serviceType:= swap(serviceType);      {force hi-lo}
   _charge     :=Lswap(charge);           {force hi-lo}
   _cancelHold :=Lswap(cancelHoldAmount); {force hi-lo}
   _objType    := swap(objType);          {force hi-lo}
   _commentType:= swap(commentType);      {force hi-lo}
   p:=ord(objName[0]);if p>48 then p:=48;
   UpString(objName);
   Move(objname[0],_objNameandComment[1],p+1);
   Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
   len:=15+p+1+ord(comment[0])+1;
   end;
F2SystemCall($17,req.len+2,0);
SubmitAccountCharge:=(result=$00);
{ resultcodes: 00 successfull; C0 No Account Privileges;
               C1 No Account Balance; C2 Credit Limit Exceeded. }
end;


{F217/98 [2.15c+]}
Function SubmitAccountHold(objName:string; objType:word;
                           reserveAmount:Longint         ):boolean;
{ To be called by accounting servers only. }
Var req:record
        len :word;
        subf:byte;
        _reserveAmount:Longint; {hi-lo}
        _objType:word; {hi-lo}
        _objName:string[48];
        end                ABSOLUTE UnitReqBuffer;
   p:byte;
begin
With req
do begin
   subf:=$98;
   _reserveAmount:=Lswap(ReserveAmount); { force hi-lo}
   _objType:=swap(objType); { force hi-lo }
   p:=ord(objName[0]); if p>48 then p:=48;
   _objName:=objname;UpString(_objName);_objName[0]:=chr(p);
   len:=7+p+1;
   end;
F2SystemCall($17,req.len+2,0);
SubmitAccountHold:=(result=$00);
{ resultcodes: 00 successfull; C0 No Account Privileges;
               C1 No Account Balance; C2 Credit Limit Exceeded.
               C3 Account Too Many Holds }
end;

{F217/99 [2.15c+]}
Function SubmitAccountNote(objName:string; objType:word;
                           serviceType,commentType:word; comment:string):boolean;
{ To be called by accounting servers only.}
Var req:record
        len:word;
        subf:byte;
        _serviceType:word; {hi-lo}
        _objType:word; {hi-lo}
        _commentType:word; {hi-lo}
        _objNameAndComment:array[1..305] of char;
        end               ABSOLUTE UnitReqBuffer;
   p:byte;
begin
with req
do begin
   subf:=$99;
   _serviceType:= swap(serviceType);      {force hi-lo}
   _objType    := swap(objType);          {force hi-lo}
   _commentType:= swap(commentType);      {force hi-lo}
   p:=ord(objName[0]);if p>48 then p:=48;
   UpString(objName);
   Move(objname[0],_objNameandComment[1],p+1);
   Move(comment[0],_objNameandComment[p+2],ord(comment[0])+1);
   len:=7+p+1+ord(comment[0])+1;
   end;
F2SystemCall($17,req.len+2,0);
SubmitAccountNote:=(result=0);
{resultcodes: 00 Successful; C0 No Account Privileges }
end;

{---------------- Secondary Functions--------------------------------------}


Function AccountingInstalled:boolean;
Var propVal:propertyType;
    connId:byte;
    moreSegments:boolean;
    propFlags:byte;
    currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
  then result:=nwConn.result
  else if NOT GetFileServerName(ConnId,currServerName)
        then result:=nwConn.result
        else begin
             ReadPropertyValue(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',1,
                               propVal,moreSegments,propFlags);
             result:=nwBindry.result;
             end;
AccountingInstalled:=(result=0);
end;


Function SetAccountStatus(objName:string; objType:word; balance,limit:LongInt):boolean;
{ will change the account status to reflect the given parameters.
  any holds will not be changed.
  You need to be supervisor-eq. to do this...}
Var accPropVal:propertyType;
    accVal: record
            _balance:LongInt; {hi-lo}
            _limit:LongInt;   {hi-lo}
            _Reserved:array[1..120] of byte; { NW internal info }
            end ABSOLUTE accPropVal;
    OldBalance,OldLimit,OldHolds:LongInt;
    moreSegments:boolean;
    propFlags:byte;
begin
IF ReadPropertyValue(objName,objType,'ACCOUNT_BALANCE',1,
                    accPropVal,moreSegments,propFlags)
  then begin
       accVal._balance:=Lswap(balance); { force hi-lo}
       accVal._limit:=Lswap(limit); { force hi-lo}
       WritePropertyValue(objName,objType,'ACCOUNT_BALANCE',
                          1,accPropVal,FALSE);
       if (nwBindry.result=$F1) or (nwBindry.result=$F8)
         then result:=$C0
         else result:=nwBindry.result;
       end
  else if nwBindry.result=$FB { no such property }
        then result:=$C1
        else if nwBindry.result=$F1 { invalid bindery security }
             then result:=$C0
             else result:=nwBindry.result;
SetAccountStatus:=(result=$00);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance;
  96 Server Out Of memory; FC No Such Object; FE Server Bindery Locked;
  FF Bindery Failure}
end;


Function AddAccountingServer(objName:string;objType:word):boolean;
Var ConnId:byte;
    currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
   then result:=nwConn.result
   else if NOT GetFileServerName(ConnId,currServerName)
           then result:=nwConn.result
           else begin
                AddBinderyObjectToSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
                                      objName,objType);
                result:=nwBindry.result;
                end;
AddAccountingServer:=(result=0);
end;

Function DeleteAccountingServer(objName:string;objType:word):boolean;
Var ConnId:byte;
    currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
   then result:=nwConn.result
   else if NOT GetFileServerName(ConnId,currServerName)
           then result:=nwConn.result
           else begin
                DeleteBinderyObjectFromSet(currServerName,OT_FILE_SERVER,'ACCOUNT_SERVERS',
                                           objName,objType);
                result:=nwBindry.result;
                end;
DeleteAccountingServer:=(result=0);
end;

Function DeleteAccountHolds(objName:string; objType:word):boolean;
{ delete all holds the caller (an accounting server) has on the
  object with name objName of type objType. }
var req:record
        len:word;
        subF:byte;
        _objType:word; {hi-lo}
        _objName:string[48];
        end                   ABSOLUTE UnitReqBuffer;
    reply:record
          _balance: LongInt; {hi-lo}
          _limit  : Longint; {hi-lo}
          reserved: array [1..120] of byte;
          _holds  : array [1..16]
                     of record
                        serverObjId:LongInt; {hi-lo}
                        HoldAmount :LongInt  {hi-lo}
                        end;
          end                 ABSOLUTE UnitReplyBuffer;
    t:byte;
    holds:LongInt;
    level:byte;
    accServerId:LongInt;
    accServerType:word;
    accServerName:string;
begin
GetBinderyAccessLevel(Level,accServerID);
GetBinderyObjectName(accServerID,accServerName,accServerType);
With req
 do begin
    len:=sizeOf(req)-2;
    subf:=$96;
    _objType:=swap(objType); { force hi-lo}
    PstrCopy(_objName,objName,48); UpString(_objName);
    end;
F2SystemCall($17,sizeOf(req),sizeOf(reply));
if result=0
 then With reply
      do begin
         holds:=0;
         for t:=1 to 16
          do if accServerID=Lswap(_holds[t].serverObjId)
           then holds:=holds+Lswap(_holds[t].holdAmount); { force lo-hi again }
         if holds<>0
          then SubmitAccountCharge(objName,objType,0,holds,
                                   accServerType,0,'clearing holds');
         end;
DeleteAccountHolds:=(result=0);
{ resultcodes: 00 success; C0 No Account Privileges; C1 No Account Balance }
end;


Function GetConnectTimeCharge(Var currentCharge:Real;Var chargeRec:TchargeRec):boolean;
Var propVal:propertyType;
    _chargeRec:TchargeRec             ABSOLUTE propVal;
    _currcharge:record
                fill:LongInt;
                currMult,currDiv:word; {hi-lo}
                end                   ABSOLUTE propVal;
    connId:byte;
    moreSegments:boolean;
    propFlags:byte;
    currServerName:string;
begin
IF NOT GetEffectiveConnectionID(ConnId)
   then result:=nwConn.result
   else if NOT GetFileServerName(ConnId,currServerName)
           then result:=nwConn.result
           else if ReadPropertyValue(currServerName,OT_FILE_SERVER,
                                     'CONNECT_TIME',1,
                                     propVal,moreSegments,propFlags)
                then begin
                     IF _currCharge.currDiv=0
                      then currentCharge:=0
                      else currentCharge:=Swap(_currCharge.currMult)/Swap(_currCharge.currDiv);
                     move(propVal[9],propVal[5],124);
                     chargeRec:=_chargeRec;
                     result:=0;
                     end
                else result:=nwBindry.result;
GetConnectTimeCharge:=(result=0);
end;



end.